Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue54/Persist/tiListView.pas

Pascal/Delphi Source File | 2000-01-07 | 12.9 KB | 477 lines

{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  Purpose: TtiListView component to 'browse' a TList of TPersistent(s)

  Revision History:
  Oct 1999, PWH, Created

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }

{
  ToDo 4-cListView:
       a) Dynamiclaly size cols
       b) Col heading even when no data (How do I do this?)
}

unit tiListView ;

interface
uses
  ComCtrls
  ,Classes
  ,TypInfo
  ,Controls
  ,Menus
  ;


const
  // Type kinds for use with tiGetProperty
  // All string type properties
  ctkString = [ tkChar, tkString, tkWChar, tkLString, tkWString ] ;
  // Integer type properties
  ctkInt    = [ tkInteger, tkInt64 ] ;
  // Float type properties
  ctkFloat  = [ tkFloat ] ;
  // All simple types (string, int, float)
  ctkSimple = ctkString + ctkInt + ctkFloat ;

type

  { ToDo 1 -ctiListView: Create ability to set col headings }
  { ToDo 1 -ctiListView: Modify so compatable with tiListViewPlus. Main issue: The Filtering }

  TtiLVOnFilterDataEvent = procedure( pData : TPersistent ; var pbInclude : boolean ) of object ;

  //----------------------------------------------------------------------------
  TtiListView = class( TCustomListView )
  private
    FData : TList ;
    FCols : TStringList ;
    FPopupMenu : TPopupMenu ;
    FpmiEdit   : TMenuItem ;
    FpmiNew    : TMenuItem ;
    FpmiDelete : TMenuItem ;


    FOnEdit : TNotifyEvent ;
    FOnNew: TNotifyEvent;
    FOnDelete: TNotifyEvent;
    FOnFilterData : TtiLVOnFilterDataEvent ;

    procedure GetPropertyNames( pPersistent : TObject ;
                                pSL : TStringList ;
                                pPropFilter : TTypeKinds = ctkSimple ) ;

    procedure OnGetRowData(Sender: TObject; Item: TListItem);
    // This is necessary when implementing OnGetFont and OnGetImage
    //procedure DoOnCustomDrawItem( Sender: TCustomListView;
    //                              Item: TListItem;
    //                              State: TCustomDrawState;
    //                              var DefaultDraw: Boolean ) ;
    procedure SetData(const Value: TList);
    function  GetColAlignment( psColName : string ) : TAlignment ;
    function  GetColWidth( const psCol : string ) : integer ;

    procedure pmiEditOnClick( sender : TObject ) ;
    procedure pmiDeleteOnClick( sender : TObject ) ;
    procedure pmiNewOnClick( sender : TObject ) ;

  protected
    procedure ApplyCols ;
  published

    property    Align ;
    property    Anchors ;
    property    Items ;
    property    MultiSelect ;
    property    OnChange ;
    property    OnChanging ;
    property    OnColumnClick ;
    property    SmallImages ;
    property    ViewStyle;
    property    RowSelect ;

    // These three properties are needed for drag-and-drop
    property    OnDragOver  ;
    property    OnDragDrop  ;
    property    OnMouseDown ;

    property    Data : TList read FData write SetData ;

    property    OnEdit   : TNotifyEvent read FOnEdit   write FOnEdit ;
    property    OnNew    : TNotifyEvent read FOnNew    write FOnNew ;
    property    OnDelete : TNotifyEvent read FOnDelete write FOnDelete ;
    property    OnFilterData : TtiLVOnFilterDataEvent
                read  FOnFilterData
                write FOnFilterData ;


  public
    constructor Create( owner : TComponent ) ; override ;
    destructor  Destroy ; override ;
    procedure   Refresh ; reintroduce ;

  end ;

implementation
uses
   SysUtils
//   ,tiUtils   // for debugging
   ;

// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
// *
// *  TtiListView
// *
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
constructor TtiListView.create(owner: TComponent);
begin
  inherited create( owner ) ;

  FCols := TStringList.Create ;

  // Configure the list view
  ReadOnly         := true ;
  HideSelection    := false ;
  ViewStyle        := vsReport ;
  RowSelect        := true ;
  // For some reason, double clicking, then showing a modal dialog on a
  // ListView that has drag&drop enabled will trigger the drag!
  // So no double clicking.
  // OnDblClick       := DoDoubleClick ;

  // Create the popup menu
  FPopupMenu := TPopupMenu.Create( self ) ;
  PopupMenu  := FPopupMenu ;

  // Create select columns menu item
  FpmiEdit          := TMenuItem.Create( self ) ;
  FpmiEdit.Caption  := '&Edit' ;
  FpmiEdit.OnClick  := pmiEditOnClick ;
  FpmiEdit.Shortcut := TextToShortcut( 'Enter' ) ;
  FPopupMenu.Items.Add( FpmiEdit ) ;

  FpmiNew          := TMenuItem.Create( self ) ;
  FpmiNew.Caption  := '&New' ;
  FpmiNew.OnClick  := pmiNewOnClick ;
  FpmiNew.Shortcut := TextToShortcut( 'Ins' ) ;
  FPopupMenu.Items.Add( FpmiNew ) ;

  FpmiDelete        := TMenuItem.Create( self ) ;
  FpmiDelete.Caption  := '&Delete' ;
  FpmiDelete.OnClick  := pmiDeleteOnClick ;
  FpmiDelete.Shortcut := TextToShortcut( 'Del' ) ;
  FPopupMenu.Items.Add( FpmiDelete ) ;


end;

destructor TtiListView.Destroy ;
begin
  FCols.Free ;
  inherited ;
end ;

//------------------------------------------------------------------------------
procedure TtiListView.OnGetRowData(Sender: TObject; Item: TListItem);
var
  i         : integer ;
  ls        : string ;
  lsCol     : string ;
  lData     : TPersistent ;
  liIndex   : integer ;
  lbInclude : boolean ;
begin
  inherited ;

  if FData = nil then
    exit ; //==>

  Assert( Item <> nil, 'Nil list item' ) ;

  Assert( FData <> nil, 'Data property not set' ) ;
  Assert( TObject( FData.Items[Item.Index]) is TPersistent,
          'Data object is not TPersistent' ) ;

  // Scan through the items in the dataList and allow for items which
  // will not be shown.
  // For a long list, this will be very slow.
  if Assigned( FOnFilterData ) then begin
    liIndex := -1 ;
    i := -1 ;
    while liIndex <> Item.Index do begin
      inc( i ) ;
      lbInclude := true ;
      lData := TObject( FData.Items[i]) as TPersistent ;
      FOnFilterData( lData, lbInclude ) ;
      if lbInclude then
        inc( liIndex ) ;
    end ;
    liIndex := i ;
  end else
    liIndex := Item.Index ;

  if liIndex < 0 then
    exit ; //==>

  lData := TObject( FData.Items[ liIndex ]) as TPersistent ;

  // The first col must be assinged to the the caption property
  if FCols.Count > 0 then begin
    lsCol := FCols.Strings[0] ;
    if lsCol <> '' then begin
      try
        ls := GetPropValue( lData, lsCol ) ;
      except
        on e:exception do begin
          raise exception.create( 'Error reading property <' +
                                  lsCol + '> ' + e.message +
                                  ' Called in TtiListView.OnGetRowData' ) ;
          ls := 'N/A' ;
        end ;
      end ;
      Item.Caption := ls  ;
    end ;
  end ;

  // Cols 1.. are added to SubItems
  for i := 1 to FCols.Count - 1 do begin
    lsCol := FCols.Strings[i] ;
    if lsCol <> '' then begin
      try
        ls := GetPropValue( lData, lsCol ) ;
      except
        on e:exception do begin
          raise exception.create( 'Error reading property <' +
                                  lsCol + '> ' + e.message +
                                  ' Called in TtiListView.OnGetRowData' ) ;
          ls := 'N/A' ;
        end ;
      end ;

      Item.SubItems.Add( ls ) ;
      Item.Data := lData ;
    end ;
  end ;

{
  // Copy this back from TtiListViewPlus
  if Assigned( FOnGetImageIndex ) and
     Assigned( SmallImages ) then begin
    liImageIndex := -1 ;
    FOnGetImageIndex( lData, liImageIndex ) ;
    Item.ImageIndex := liImageIndex ;
  end ;
}

end;

procedure TtiListView.SetData(const Value: TList ) ;
begin

  if FData = Value then
    exit ; //==>

  FData := Value ;

  if (FData = nil) or
     (FData.Count<1) then begin
    Items.Count := 0 ;
    OwnerData := false ;
    OnData    := nil ;
    exit ; //==>
  end;

  // Read the abailable cols from the first element of the object list
  // into FLVConfig.ColsAvailable
{
  if ( Data <> nil ) and
     ( Data.Count > 0 ) and
     ( TObject( Data.Items[0] ) is TPersistent ) then begin
    // Read all properties
    GetPropertyNames( ( TObject( Data.Items[0] ) as TPersistent),
                        FCols ) ;

  end ;
}

//  OnData    := OnGetRowData ;
//  OwnerData := true ;

//  Items.Count := 0 ;
  Refresh ;

end ;


procedure TtiListView.refresh ;
var
  i : integer ;
  liCount : integer ;
  lData : TPersistent ;
  lbInclude : boolean ;
begin

  { ToDo 1 -cListView: Save the position of the cursor before refreshing }
  OnData    := nil ;
  OwnerData := false ;
  Items.Clear ;

  liCount := 0 ;
  for i := 0 to FData.Count - 1 do begin
    lData := TObject( FData.Items[i] ) as TPersistent ;
    if Assigned( FOnFilterData ) then begin
      lbInclude := true ;
      FOnFilterData( lData, lbInclude ) ;
      if lbInclude then
        inc( liCount ) ;
    end else
      inc( liCount ) ;
  end ;

  if liCount > 0 then begin
    // The order of these three assignments is important.
    // Do not change the order.
    // Must set OwnerData, ApplyCols, Items.Count, OnData order.
    OwnerData   := true ;
    ApplyCols ;
    Items.Count := liCount ;
    OnData      := OnGetRowData ;
  end ;

  inherited Refresh ;
end ;

procedure TtiListView.ApplyCols ;
var
  i : integer;
  lsColName : string ;
  lAlignment : TAlignment ;
begin

  Visible := false ;
  Cursor := crHourGlass ;
  try

    // Read all the available cols into the col string list
    if ( Data <> nil ) and
       ( Data.Count > 0 ) and
       ( TObject( Data.Items[0] ) is TPersistent ) then begin
      // Read all properties
      GetPropertyNames( ( TObject( Data.Items[0] ) as TPersistent),
                          FCols ) ;
     end ;

    Columns.Clear ;

    // Note: Col[0] will always be left justified, so it may be necessary
    //       to add a dummy col[0]
    // Read the column headings
    for i := 0 to FCols.count - 1 do begin
      lsColName := FCols.Strings[i] ;
      if ( lsColName <> '' ) then begin
        try
          lAlignment := GetColAlignment( lsColName ) ;
          Columns.Add ;
          Columns[Columns.Count-1].Caption   := lsColName ;
          Columns[Columns.Count-1].Width     := GetColWidth( lsColName ) ;
          Columns[Columns.Count-1].Alignment := lAlignment ;
        except end ;
      end ;
    end ;
  finally
    Cursor  := crDefault ;
    Visible := true ;
  end ;
end;

function TtiListView.GetColWidth( const psCol : string ) : integer ;
begin
  result := 100 ;
end ;

// Derive the column alignment from the col's data type.
// Note: Col[0] will always be left justified.
//------------------------------------------------------------------------------
function TtiListView.GetColAlignment( psColName : string ) : TAlignment ;
var
  lPropType : TTypeKind ;
begin
  result := taLeftJustify ;
  if ( Data = nil ) or
     ( Data.Count = 0 ) or
     ( Data.Items[0] = nil ) then
    exit ; //==>

  Assert( TObject(Data.Items[0]) is TPersistent,
            'Object in list passed as data to TtiListView not TPersistent' ) ;

  lPropType := PropType( ( TObject(Data.Items[0]) as TPersistent ), psColName ) ;
  if lPropType in [ tkInteger, tkInt64, tkFloat ] then
    result := taRightJustify ;

end ;

{
procedure TtiListView.DoOnCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if Assigned( FOnGetFont ) then
    FOnGetFont( ( TObject( Item.Data ) as TPersistent ),
                Canvas.Font ) ;
  DefaultDraw := true ;
end;
}

procedure TtiListView.GetPropertyNames(pPersistent: TObject;pSL: TStringList; pPropFilter: TTypeKinds);
var
  lCount : integer ;
  lSize  : integer ;
  lList  : PPropList ;
  i : integer ;
  lPropFilter : TTypeKinds ;
begin
  Assert( pPersistent <> nil, 'pPersistent not assigned.' ) ;
  Assert( pSL <> nil, 'pSL not assigned.' ) ;
  lPropFilter := pPropFilter ;
  pSL.Clear ;
  lCount := GetPropList(pPersistent.ClassInfo, lPropFilter, nil);
  lSize := lCount * SizeOf(Pointer);
  GetMem(lList, lSize);
  try
    GetPropList(pPersistent.ClassInfo, lPropFilter, lList);
    for i := 0 to lcount - 1 do
      psl.add( lList[i].Name ) ;
  finally
    FreeMem( lList, lSize ) ;
  end ;
end;

procedure TtiListView.pmiDeleteOnClick(sender: TObject);
begin
  if ( Selected <> nil ) and
     ( Assigned( FOnDelete )) then
    FOnDelete( Selected ) ;
end;

procedure TtiListView.pmiEditOnClick(sender: TObject);
begin
  if ( Selected <> nil ) and
     ( Assigned( FOnEdit )) then begin
    FOnEdit( Selected ) ;
    SetFocus ;
  end ;
end;

procedure TtiListView.pmiNewOnClick(sender: TObject);
begin
  if ( Assigned( FOnNew )) then begin
    FOnNew( nil ) ;
    SetFocus ;
  end ;
end;

end.